; ORIGINAL: 3dt2.1/examples/schemers/objects.scm
;;
;; objects.scm
;;
;; A collection of objects together with sample flight procedures.
;;
;; Edward C. Martin, Schemers Inc.
;; 27 January 1994
;;

;; Clear the slate, and establish a Standard View as the only view
;;
(part:clear)
(for-each view:delete (env:views))

(load "std-view.scm")

;; Load some basic rendering and coloring procedures.
;;
(load "rdrpaint.scm")

;; create an equilateral triangular prism
;;
(define wedge
  (solid:sweep-wire
    (wire-body
      (list
        (edge:linear (position 0 0 -20) (position 30 0 -20))
        (edge:linear (position 30 0 -20) (position 30 60 -20 "polar"))
        (edge:linear (position 30 60 -20 "polar") (position 0 0 -20))))
    40))

;; create a hexagonal collar by uniting 6 copies of the equilateral
;; triangular prism and drilling a large cylindrical hole along the axis.
;;
(define hex-collar
  (solid:subtract
    (apply solid:unite
           (cons wedge
                 (map (lambda (angle)
                        (entity:transform
                          (entity:copy wedge)
                          (transform:rotation
                            (position 0 0 0) (gvector 0 0 1) angle)))
                      '(60 120 180 240 300))))
    (solid:cylinder
      (position 0 0 -20) (position 0 0 20) 20)))

;; turn the collar through 90 degrees and punch six holes in it.
;;
(entity:transform
  (solid:subtract
    hex-collar
    (solid:cylinder
      (position 30 -30 0 "polar") (position 30 150 0 "polar") 10)
    (solid:cylinder
      (position 35 -90 7.5 "polar") (position 35 90 7.5 "polar") 10)
    (solid:cylinder
      (position 35 30 -7.5 "polar") (position 35 210 -7.5 "polar") 10))
  (transform:rotation (position 0 0 0) (gvector 1 0 0) 90))

;; create a ball in the center of the hexagonal collar.
;;
(define ball
  (solid:sphere (position 0 0 0) 10))

;; create a cone lying on its side at one end of the collar's axis.
;;
(define cone
  (solid:cone (position 0 60 0) (position 0 30 0) 10 0))

;; create a tilted cube at the other end of the collar's axis.
;;
(define block
  (entity:transform
    (solid:block (position 10 -40 -10) (position -10 -60 10))
    (transform:rotation (position -10 -40 10) (gvector 1 1 1) 60)))

;; paint and render the objects.
;;
(entity:paint hex-collar GREEN)
(entity:paint ball RED)
(entity:paint cone YELLOW)
(entity:paint block MAGENTA)
(entity:facet (part:entities (filter:type "solid?")))
(render)

;; create a spline edge that winds in and around the objects.
;;
(define flight-path
  (edge:spline
    (list
      (position 20 -70 -10) (position 15 -50 -20) (position 5 -15 -32)
      (position -5 0 -18) (position -20 10 -15) (position -30 20 -10)
      (position -40 0 10) (position -30 -5 8) (position -15 -5 10)
      (position 0 -12 20) (position 10 0 30) (position 25 0 25)
      (position 20 5 15) (position 15 15 5) (position 0 25 -5)
      (position -15 35 0) (position -10 40 5))))

;; A procedure that causes an in-flight view to appear, given the flight path
;; edge, the current step-number, the total number of steps to be taken, and
;; the desired viewing distance.
;;
(define in-flight-view
  (lambda (fl-path-edge step-num nsteps vw-dist)
    (let* ((param-val (/ step-num nsteps))
           (eye-pos (curve:eval-pos fl-path-edge param-val))
           (vw-gvec (gvector:scale
                      (gvector:unitize
                        (curve:eval-tan
                          fl-path-edge param-val))
                      vw-dist)))
      (view:set-eye eye-pos)
      (view:set-target (position:offset eye-pos vw-gvec))
      (render))))

;; A procedure that flies along a specified flight path edge, taking a given
;; number of steps, all the while maintaining a specified viewing distance.
(define fly
  (lambda (fl-path-edge nsteps vw-dist)
    (view:set-perspective #t)
    (do ((step-num 0 (+ step-num 1)))
        ((> step-num nsteps) 'done)
        (in-flight-view fl-path-edge step-num nsteps vw-dist))))

;;; end of file  objects.scm
